Objectives

Confirm stem profile patterns seen previously by:

Assist with Calibre log tool install.

Finalise plan for trial.

Background

TODO: simple model for SWV profile based on radial gradient in MOE and heartwood fraction.

Methods

40 stems (#’s 1-40) laid out, measured and restacked to be used to compare with Calibre tool post-install.

43 stems (#’s 41-83) laid out, measured and then cut to logs of various lengths in order to map variation in SWV along the stem length.

Stems 61 and 62 cut to final log lengths in two stages to test capture of hitman spectra on short lengths. Pieces labelled 61a, 61b, etc then 61aa, 61ab, etc. Spectra capture appeared reasonable so remaining logs cut to final lengths immediately.

55 top proper log probably actually 56 top log. 56 top log should be ok.

LogUI app used to collect data. Separate databases used for calibre comparison and intrastem swv profiling. This was a mistake, should have used a single database throughout. Remedied with process.py.

SWV extracted from raw hitman signal using algorithim in hitman.py with manual override.

Calibre comparison 40 stems run late on 8jun2015. SWI stem number sequence recorded by Justin (see justin_stem_sequence.jpg). Calibre log tool removed for major repairs shortly after.

Results

Raw Hitman

Plot hitman results as a check on database completeness:

library(DBI)
ch = dbConnect(RSQLite::SQLite(), dbname="/home/harrinjj/G/Projects/JNL_Gisborne_2015/logs-jnl-jun2015.db3")
sql = "select l.*, d.*, p.value as length from logs l, hitmanScans s, hitmanScanData d, properties p where l.id=s.logId and d.scanId=s.id and l.id=p.logId and p.measure='length' order by d.t"
X = dbGetQuery(ch, sql)
#str(X)
library(lattice)
xyplot(s ~ t|paste(logName,'-',length,'m'), group=scanId, X, type="l", 
       panel=function(x,y,...) {
         panel.xyplot(x,abs(fft(y/sum(y))),...)
       }, 
       xlim=c(0,1024), 
       ylim=c(0,0.7),
       layout=c(4,74)) #, subset=logName=="1")

Stem and Log Data

library(DBI)
#library(RSQLite)
ch = dbConnect(RSQLite::SQLite(), dbname="/home/harrinjj/G/Projects/JNL_Gisborne_2015/logs-jnl-jun2015.db3")
sql = "select l.logName, l.insertTime as measTime,
r.length, r.z, r.swv,
r.scanId,
butt.value as butt,
cast(sed.value as real) as SED,
cast(led.value as real)  as LED,
hwhwd.value/hwod.value as hwfrac
from logs l left join results r on l.id=r.logId left join 
(select * from properties where measure='buttlog') butt on butt.logId=l.id left join
(select * from properties where measure='led') led on led.logId=l.id left join
(select * from properties where measure='sed') sed on sed.logId=l.id left join
(select logId, cast(value as real) value from properties where measure='hwhwd') hwhwd on hwhwd.logId=l.id left join
(select logId, cast(value as real) value from properties where measure='hwod') hwod on hwod.logId=l.id
"
R = dbGetQuery(ch, sql)
R$hwfrac = as.numeric(R$hwfrac) # no idea why I have to do this, but...
R$stem = as.numeric(regmatches(R$logName,regexpr('([[:digit:]]+)',R$logName)))
R$posn=R$logName
regmatches(R$posn,regexpr('([[:digit:]]+)',R$logName)) <- ""
#wrong.scans=c(1096,1115,1126,1148,1149,1157,1166,1173,1182,1202,1203,1205,1228)
#mispeaked.scans=c(1080,1106,1109,1111,1117,1128,1142,1143,1157,1165,1191,1192,1194,1197,1213,1220,1238,1248,1249)
#1079,1084,1110,1158,1232,1237,1245,
#R = R[R$scanId%in%setdiff(unique(R$scanId),union(wrong.scans,mispeaked.scans)),]

SWV and Length

hist(R$swv)

library(lattice)
xyplot(swv ~ length, R, panel=function(...){
  panel.xyplot(...)
  panel.abline(v=1.0)
})

bwplot(swv ~ factor(round(length)), R, xlab="Log Length / [m]")

SWV incredible from logs whose length is less than 1.0 m.

Average log SWV vs stem SWV

S = data.frame(stem=c(41:83))
for (i in 1:nrow(S)) {
  ii = R$stem==S$stem[i] & R$posn%in%c("a","b","c","d","e","f") & R$length>1.0 & R$swv>0.
  LL = sum(R$length[ii])
  TT = sum(R$length[ii]/R$swv[ii])
  S[i,"avg.log.swv"] = LL/TT
  S[i,"stem.swv"] = R$swv[R$stem==S$stem[i] & R$posn==""]
}
#plot(S$stem.swv,S$avg.log.swv)
#identify(S$stem.swv,S$avg.log.swv,S$stem)
xyplot(stem.swv ~ avg.log.swv, S, panel=function(...) {
  panel.abline(c(0,1), col="grey70")
  panel.xyplot(...)
})

summary(lm(stem.swv ~ avg.log.swv, S)) # r2=0.94
## 
## Call:
## lm(formula = stem.swv ~ avg.log.swv, data = S)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -123.42  -38.83  -10.10   33.11  174.89 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept) 162.7896   119.6996    1.36    0.181    
## avg.log.swv   0.9536     0.0374   25.50   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 60.68 on 40 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.942,  Adjusted R-squared:  0.9406 
## F-statistic: 650.2 on 1 and 40 DF,  p-value: < 2.2e-16

Stem 73 has a much higher avg.log.swv (2800) compared to stem.swv (<2800). The stem sonic trace is sketchy, perhaps the stem had a broken/knotty patch that disappeared when cut into logs. But the stem profile shows 4 ridiculously high swv logs and 2 very low swv logs.

Log 70 is the most extreme point, but see discussion below of stem profile.

Stem Profiles

R$piece.type="log"
R$piece.type[R$posn==""]="stem"
R$piece.type=factor(R$piece.type)
for (s in 1:83) {
  ii=R$stem==s
  R$swv.rel[ii]=R$swv[ii]/R$swv[R$logName==sprintf('%i',s)]
}
xyplot(swv.rel ~ z | as.factor(stem), group=piece.type, R, subset=R$length>1.5&R$stem>40,panel=function(...){
  panel.abline(h=1., col="pink")
  panel.xyplot(...)
})

# todo:
# - normalize log swv using stem swv DONE
# - draw stem swv as line reather than point DONE

Total variation in log SWV typically within ±5% of the parent stem SWV.

79a,b are both 1.35m long, with dodgy spectra.

Stem SWV higher than any log from stem 70. Log and stem spectra have been checked and all appear ok.

Stem 49 was made into two logs, one nearly the full length with good spectra and one 1.3 m with bad spectra.

Top logs from 41 are very low, but also very short (1.05m)

Repeated SWV Measures

Logs 1,2,3 were measured twice. How do their SWV’s compare?

ii = R$stem<41
plot(jitter(R$stem[ii]),R$swv[ii])

#identify(R$stem[ii],R$swv[ii],R$logName[ii])

Very similar.

Butt Stems

Do stems definitely from butt have different profiles to other stems? Are butt stems more likely to exhibit a ‘hook’?

butt.stems = unique(R$stem[R$butt=='y'])
xyplot(swv.rel ~ z | as.factor(stem), group=piece.type, R, 
       subset=R$length>1.5&R$stem>40&R$stem%in%butt.stems,
       panel=function(...){
  panel.abline(h=1., col="pink")
  panel.xyplot(...)
}, main="Butt Stems Only")

Perhaps a higher fraction of butt stems exhibit a hook compared to all stems, but the hook is small (<&plusmn&5%).

Heartwood

Heartwood fraction was estimated for a single cross-section near the middle of the stem based on measurements of heartwood diameter and under-bark diameter.

summary(R$hwfrac)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##  0.3226  0.4479  0.5405  0.5255  0.6173  0.6957     258
hist(R$hwfrac)

plot(R$stem, R$hwfrac)

Heartwood fraction ranges widely from 30 to 70%.

Merge Feb and Jun Results

F = new.env()
load(file="feb2015.Rdata", envir=F)
#str(F$S)
#str(F$L)
#str(F$SL)
# get rid of duplicates from jun dataset
library(plyr)
colMean = function(df) {
  mean.or.1st = function(x) {
    y <- tryCatch(mean(x,na.rm=TRUE), 
             warning=function(e) x[1]
             )
    if (is.nan(y)) y <- NA
    y
    }
  data.frame(sapply(df,mean.or.1st,simplify=FALSE))
  }

RR = ddply(R, .(logName), colMean)
# convert log posn (a,b,c...) to number (1,2,3...)
for (logNumber in 1:6) {
  RR$log[RR$posn==letters[logNumber]] <- logNumber
}
RR$stem = paste("J",RR$stem,sep=".")
RR$swv = RR$swv/1000.
RR <- RR[RR$length>1.0&RR$swv>0.,] # drop short logs and logs with crap swv
S <- RR[RR$posn=="",]
L <- RR[RR$posn!="",]
# transfer hwfrac to stems
for (i in 1:nrow(L)) if (is.finite(L$hwfrac[i])) S[S$stem==L$stem[i],"hwfrac"] <- L$hwfrac[i]
#
#str(S)
#str(F$S)
F$S$butt = factor(c("n","y")[as.numeric(F$S$with.scarf.)])
F$S$stem = paste("F",F$S$stem,sep=".")
F$S$hwfrac = NA
S.cols = c("stem","length","butt","LED","SED","swv","hwfrac")
S = rbind(S[,S.cols], F$S[,S.cols])
#
#str(L)
#str(F$L)
F$L$stem = paste("F",F$L$stem,sep=".")
# transfer z from F$SL to F$L
for (i in 1:nrow(F$SL)) F$L[F$L$stem==paste('F',F$SL$stem[i],sep=".")&F$L$log==F$SL$log[i],"z"] <- F$SL$z[i]
L.cols = c("stem","length","log","swv","z")
L = rbind(L[,L.cols], F$L[,L.cols])
#
SL <- merge(S,L,by="stem",suffixes=c(".stem",".log"))
SL$LEposInStem = 'unknown LE position-in-stem'
SL$LEposInStem[SL$butt=='y'] = 'LE at stem butt'
xyplot(swv.log ~ z | as.factor(stem), group=LEposInStem, SL, auto.key=T,
       #stem.levels=levels(as.factor(SL$stem)),
       panel=function(x,y,...){
         if (length(x)>3) {
          m = lm(y ~ x + I(x^2))        
          } else {
            m = lm(y ~ x)        
          }
         z = seq(0,13,by=0.1)
         panel.xyplot(z,predict(m,data.frame(x=z)),col="grey30",type="l")
         panel.xyplot(x,y,...)
       })

TODO: hierarchical mixed model for SWV(z; stem.swv, stem.length, stem.led, stem.sed, stem.hwfrac)

40 Stem Calibre v Hitman Comparison

Load all the logged calibre data:

#C = read.csv('/home/harrinjj/G/Projects/JNL_Gisborne_2015/calibre40results_8jun2015.csv')
#C$t = as.POSIXct(strptime(C$Timestamp,"%m/%d/%Y %H:%M:%S"))
#str(C)

Hmmm. 37 records collected between 5:15 and 7:00p on Jun 8 (Monday night). Can’t possibly contain all 40 test stems!

#seq.40 = read.csv('/home/harrinjj/G/Projects/JNL_Gisborne_2015/calibre40order_8jun2015.csv')
#seq.40$order=1:nrow(seq.40)
#write.csv(merge(seq.40,R[R$stem<41,c('stem','length','swv')],by.x='stem.number',by.y='stem',all.x=TRUE),file="tmp.csv")

After manual matching:

library(gridExtra)
## Loading required package: grid
C = read.csv('/home/harrinjj/G/Projects/JNL_Gisborne_2015/calibre40results_manualmatch.csv')
C$calibre.swv = apply(C[,c("AWV_1","AWV_2")],1,max)
mypanel = function(...){
  panel.abline(c(0,1),col="grey70")
  panel.xyplot(...)
  }
grid.arrange(
  xyplot(swi.length ~ calibre.length/1000., C, panel=mypanel),
  xyplot(hitman.swv ~ calibre.swv, C, panel=mypanel),
  nrow=1
)

Both length and SWV leave much to be desired.

Peeler Cores

We had time to spare, so we measured a handful of 2.2 m peeler cores to get some sort of handle on:

  1. feasibility of measuring peeler core swv with Hitman
  2. swv variability in centre of peeler logs (not synonymous with variation in swv near pith due to geometric variation!)

Short, but small diameter.

When tested these cores had cooled, but otherwise were straight off the peeler. They seemed pretty dry.

ch = dbConnect(RSQLite::SQLite(), dbname="/home/harrinjj/G/Projects/JNL_Gisborne_2015/peelercores-jnl-jun2015.db3")
sql = "select l.*, d.* from logs l, hitmanScans s, hitmanScanData d where l.id=s.logId and d.scanId=s.id order by d.t"
X = dbGetQuery(ch, sql)
#str(X)
library(lattice)
xyplot(s ~ t|paste(logName), group=scanId, X, type="l", 
       panel=function(x,y,...) {
         panel.xyplot(x,abs(fft(y/sum(y))),...)
       }, 
       xlim=c(0,1024), 
       ylim=c(0,2.),
       layout=c(4,7)) #, subset=logName=="1")

While not pretty spectra appear useable.

sql = "select * from logs l left join results r on l.id=r.logId"
C = dbGetQuery(ch, sql)
summary(C$swv)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    2217    2511    2882    2974    3285    4117
histogram(~swv, C, subset=swv>0, type="count")

Variation similar to what we see in full logs, but remember the peeler cores are drier than a green log.

Conclusions

Hard to get useable swv from hitman on logs less than 2.0 m long. Impossible on logs less than 1.0 m.

Peeler core SWV is measurable.

Both these results and those from February suggest that: